packages feed

anki-tools (empty) → 0.1.0.0

raw patch · 13 files changed

+940/−0 lines, 13 filesdep +aesondep +anki-toolsdep +basesetup-changed

Dependencies added: aeson, anki-tools, base, bytestring, data-default, directory, exceptions, filepath, mtl, scientific, sqlite-simple, text, time, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Al Zohali++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Al Zohali nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ anki-tools.cabal view
@@ -0,0 +1,70 @@+name:                anki-tools+version:             0.1.0.0+synopsis:            Tools for interacting with Anki database+-- description:+license:             BSD3+license-file:        LICENSE+author:              Al Zohali+maintainer:          zohl@fmap.me+-- copyright:+category:            Database+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/zohl/anki-tools.git++flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False++library+  exposed-modules:+    Anki.Tools+    Anki.Collection+    Anki.Common+    Anki.Model+    Anki.Deck+    Anki.Note+    Anki.Card+    Anki.Misc+    Anki.UserProfile++  build-depends: base >=4.8 && < 5.0+               , aeson+               , bytestring+               , data-default+               , directory+               , exceptions+               , filepath+               , mtl+               , scientific+               , sqlite-simple+               , time+               , text+               , unordered-containers++  hs-source-dirs:      src+  default-language:    Haskell2010++  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall+++executable anki-tools-test+  hs-source-dirs:     test+  main-is:            Main.hs+  build-depends: base >= 4.7 && < 5.0+               , anki-tools+               , data-default++  default-language:    Haskell2010++  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall
+ src/Anki/Card.hs view
@@ -0,0 +1,71 @@+{-|+  Module:      Anki.Card+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Representation of a card and related definitions.+-}++{-# LANGUAGE DeriveGeneric #-}++module Anki.Card (+    CardId+  , Card(..)+  ) where+++import Anki.Common (ModificationTime)+import Anki.Deck (DeckId)+import Anki.Note (NoteId)+import Data.Text (Text)+import Database.SQLite.Simple (FromRow(..), field)+import GHC.Generics (Generic)++-- | Type for card ids.+type CardId = Int++-- | Cards from cards table.+data Card = Card {+    cardId     :: CardId+  , cardNid    :: NoteId+  , cardDid    :: DeckId+  , cardOrd    :: Int   -- TODO check type+  , cardMod    :: ModificationTime+  , cardUsn    :: Int   -- TODO check type+  , cardType   :: Int   -- TODO check type+  , cardQueue  :: Int   -- TODO check type+  , cardDue    :: Int   -- TODO check type+  , cardIvl    :: Int   -- TODO check type+  , cardFactor :: Int   -- TODO check type+  , cardReps   :: Int   -- TODO check type+  , cardLapses :: Int   -- TODO check type+  , cardLeft   :: Int   -- TODO check type+  , cardOdue   :: Int   -- TODO check type+  , cardOdid   :: Int   -- TODO check type+  , cardFlags  :: Int   -- TODO check type+  , cardData   :: Text  -- TODO check type+  } deriving (Show, Eq, Generic)++instance FromRow Card where+  fromRow = Card+    <$> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field
+ src/Anki/Collection.hs view
@@ -0,0 +1,110 @@+{-|+  Module:      Anki.Collection+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Representation of a collection and related definitions.+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE FlexibleInstances #-}++module Anki.Collection (+    Collection(..)+  , GlobalOptions(..)+  , Tag(..)+  ) where+++import Anki.Common (ModificationTime, AnkiException(..), throwErr)+import Anki.Common (dropPrefixOptions, getTextValue, getJsonValue, fromDictionary)+import Anki.Deck (DeckId, Deck, DeckOptions)+import Anki.Model (ModelId, Model)+import Data.Aeson (Value(..), decode, FromJSON(..), genericParseJSON)+import Data.Text (Text)+import Database.SQLite.Simple (FromRow(..), field)+import Database.SQLite.Simple.FromField (FromField(..))+import Database.SQLite.Simple.Internal (Field(..))+import Database.SQLite.Simple.Ok (Ok(..))+import GHC.Generics (Generic)+import qualified Data.Text as T+++-- | Collection as in col table.+data Collection = Collection {+    collectionId            :: Int            -- ^ collection identifier (id)+  , collectionCrt           :: Int            -- TODO check type+  , collectionMod           :: ModificationTime+  , collectionScm           :: Int            -- TODO check type+  , collectionVer           :: Int            -- TODO check type+  , collectionDty           :: Int            -- TODO check type+  , collectionUsn           :: Int            -- TODO check type+  , collectionLs            :: Int            -- TODO check type+  , collectionGlobalOptions :: GlobalOptions  -- ^ global options (col.conf)+  , collectionModels        :: [Model]        -- ^ models in the collection(col.models)+  , collectionDecks         :: [Deck]         -- ^ decks in the collection (col.decks)+  , collectionDeckOptions   :: [DeckOptions]  -- ^ deck options (col.dconf)+  , collectionTags          :: [Tag]          -- ^ tags (col.tags)+  } deriving (Show, Eq, Generic)++instance FromRow Collection where+  fromRow = Collection+    <$> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+++-- | Global opitions.+data GlobalOptions = GlobalOptions {+   goNextPos       :: Value     -- TODO Int?+ , goEstTimes      :: Value     -- TODO Bool?+ , goSortBackwards :: Value     -- TODO Bool?+ , goSortType      :: Value     -- TODO String?+ , goTimeLim       :: Value     -- TODO Int?+ , goActiveDecks   :: [DeckId]  -- ^ TODO+ , goAddToCur      :: Value     -- TODO Bool?+ , goCurDeck       :: Value     -- TODO DeckId?+ , goCurModel      :: ModelId   -- ^ TODO+ , goLastUnburied  :: Value     -- TODO Int?+ , goCollapseTime  :: Value     -- TODO Int?+ , goActiveCols    :: Value     -- TODO [String]?+ , goSavedFilters  :: Value     -- TODO [wtf]?+ , goDueCounts     :: Value     -- TODO Bool?+ , goNewBury       :: Value     -- TODO Bool?+ , goNewSpread     :: Value     -- TODO Int?+ } deriving (Show, Eq, Generic)++instance FromJSON GlobalOptions where+  parseJSON = genericParseJSON dropPrefixOptions++instance FromField GlobalOptions where+  fromField f = getTextValue f >>= maybe (throwErr f WrongJsonFormat) return . decode+++-- | Tags from col.tags.+data Tag = Tag {+    tagName   :: String -- ^ tag name (key)+  , tagNumber :: Int    -- ^ TODO: wtf? (value)+  } deriving (Show, Eq)++instance FromField [Tag] where+  fromField f = getJsonValue f >>= fromDictionary mkTag f where+    mkTag :: Field -> (Text, Value) -> Ok Tag+    mkTag f' = \case+      (name, Number number) -> return $ Tag (T.unpack name) (round number)+      _                     -> throwErr f' WrongJsonFormat+
+ src/Anki/Common.hs view
@@ -0,0 +1,159 @@+{-|+  Module:      Anki.Common+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Auxiliary functions and types.+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Anki.Common (+    AnkiException(..)+  , WeaklyTypedInt(..)+  , WeaklyTypedBool(..)+  , ModificationTime(..)+  , throwErr+  , getTextValue+  , getJsonValue+  , fromDictionary+  , mkEntry+  , dropPrefixOptions+  ) where+++import Control.Exception (Exception)+import Control.Monad (unless)+import Data.Aeson (Value(..), encode, decode, FromJSON(..))+import Data.Aeson.Types (Options(..), defaultOptions)+import Data.Char (toLower, isUpper)+import Data.HashMap.Strict (toList)+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Typeable (Typeable)+import Database.SQLite.Simple (SQLData(..))+import Database.SQLite.Simple.FromField (FromField(..), ResultError(..), returnError)+import Database.SQLite.Simple.Internal (Field(..))+import Database.SQLite.Simple.Ok (Ok(..))+import qualified Data.ByteString.Lazy.Char8 as BSLC8+import qualified Data.Text as T+++-- | The exception is thrown when something goes wrong with this package.+data AnkiException+  = WrongFieldType+  -- ^ Thrown when column type is not a text.+  | NotJson+  -- ^ Thrown when text from database is not a valid json.+  | WrongJsonFormat+  -- ^ Thrown when json format differs from expected one.+  | ModelIdInconsistent+  -- ^ Thrown when external and internal ids of model differ.+  | DeckIdInconsistent+  -- ^ Thrown when external and internal ids of deck differ.+  | DeckOptionsIdInconsistent+  -- ^ Thrown when external and internal ids of deck options differ.+  deriving (Eq, Show, Typeable)++instance (Exception AnkiException)++-- | Exit from Ok monad.+throwErr :: (Typeable a) => Field -> AnkiException -> Ok a+throwErr f ex = returnError ConversionFailed f $ show ex++-- | Read field as a byte sequence.+getTextValue :: Field -> Ok BSLC8.ByteString+getTextValue = \case+  (Field (SQLText txt) _) -> return . BSLC8.pack . T.unpack $ txt+  f                       -> throwErr f WrongFieldType++-- | Read field as a JSON.+getJsonValue :: Field -> Ok Value+getJsonValue f = getTextValue f >>= getValue where+  getValue :: BSLC8.ByteString -> Ok Value+  getValue = maybe (throwErr f NotJson) return . decode++-- | Transform a JSON-dictionary to a list of values.+fromDictionary :: (Typeable a) => (Field -> (Text, Value) -> Ok a) -> Field -> Value -> Ok [a]+fromDictionary mkEntry' f = \case+  (Object o) -> mapM (mkEntry' f) (toList o)+  _          -> throwErr f WrongJsonFormat++-- | Transform a single pair from JSON-dictionary of type { <id>: {id: <id>, ....} } to a record.+mkEntry :: (Typeable a, FromJSON a, Eq b, Typeable b, FromJSON b)+  => (a -> b)+  -> AnkiException+  -> Field+  -> (Text, Value)+  -> Ok a++mkEntry entryId entryIdException f (key, value) = do+  entryId' <- maybe+    (throwErr f WrongJsonFormat)+    return+    (decode . BSLC8.pack . T.unpack $ key)++  entry <- maybe+    (throwErr f WrongJsonFormat)+    return+    (decode . encode $ value)++  unless (entryId' == entryId entry) $ throwErr f entryIdException+  return entry++-- | Cut the first word and lowercase the second.+dropPrefix :: String -> String+dropPrefix "" = ""+dropPrefix (c:t)+  | isUpper c = toLower c : t+  | otherwise = dropPrefix t++-- | Default options used in Aeson typeclasses in this module.+dropPrefixOptions :: Options+dropPrefixOptions = defaultOptions { fieldLabelModifier = dropPrefix }++-- | A wrapper to handle integers and strings with integers.+newtype WeaklyTypedInt = WeaklyTypedInt { getInt :: Int } deriving (Show, Eq, Num)++instance FromJSON WeaklyTypedInt where+  parseJSON = fmap fromInteger . \case+    (String s) -> return . read . T.unpack $ s+    (Number x) -> return . round $ x+    _ -> error "TODO"++instance FromField WeaklyTypedInt where+  fromField f = fromInteger <$> fromField f++-- | A wrapper to handle booleans, strings with booleans and 0-1 integers.+newtype WeaklyTypedBool = WeaklyTypedBool { getBool :: Bool } deriving (Show, Eq)++instance FromJSON WeaklyTypedBool where+  parseJSON = fmap WeaklyTypedBool . \case+    (String s) -> case s of+      "false" -> return False+      "true"  -> return True+      _       -> error "TODO"++    (Number x) -> case x of+      0 -> return False+      1 -> return True+      _ -> error "TODO"++    _ -> error "TODO"+++-- | A wrapper handle time in POSIX format.+newtype ModificationTime = ModificationTime { getModificationTime :: UTCTime } deriving (Show, Eq)++instance FromField ModificationTime where+  fromField f = (ModificationTime . posixSecondsToUTCTime . fromInteger) <$> fromField f++instance FromJSON ModificationTime where+  parseJSON = fmap (ModificationTime . posixSecondsToUTCTime . fromInteger) . parseJSON
+ src/Anki/Deck.hs view
@@ -0,0 +1,180 @@+{-|+  Module:      Anki.Deck+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Representation of a deck and related definitions.+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}++module Anki.Deck (+    DeckOptions(..)+  , DeckOptionsId+  , DeckOptionsLapse(..)+  , DeckOptionsRev(..)+  , DeckOptionsNew(..)++  , Deck(..)+  , DeckExtension(..)+  , DeckId+  ) where+++import Anki.Common (WeaklyTypedInt, WeaklyTypedBool(..), ModificationTime, AnkiException(..))+import Anki.Common (dropPrefixOptions, getJsonValue, fromDictionary, mkEntry)+import Data.Aeson (Value(..), FromJSON(..), genericParseJSON)+import Data.Aeson.Types ((.:), withObject)+import Database.SQLite.Simple.FromField (FromField(..))+import GHC.Generics (Generic)++-- | Type for deck options ids.+type DeckOptionsId = WeaklyTypedInt++-- | Representation of deck options.+data DeckOptions = DeckOptions {+    doId       :: DeckOptionsId+  , doAutoplay :: Value -- TODO Bool?+  , doDyn      :: Value -- TODO Bool?+  , doLapse    :: DeckOptionsLapse  -- ^ TODO+  , doMaxTaken :: Value -- TODO Int?+  , doMod      :: ModificationTime+  , doName     :: Value -- TODO String?+  , doNew      :: DeckOptionsNew    -- ^ TODO+  , doReplayq  :: Value -- TODO Bool?+  , doRev      :: DeckOptionsRev    -- ^ TODO+  , doTimer    :: Value -- TODO Int/Bool?+  , doUsn      :: Value -- TODO Int?+  } deriving (Show, Eq, Generic)++instance FromJSON DeckOptions where+  parseJSON = genericParseJSON dropPrefixOptions++instance FromField [DeckOptions] where+  fromField f = getJsonValue f >>= fromDictionary (mkEntry doId DeckOptionsIdInconsistent) f+++-- | Volatile fields of col.decks.+data DeckExtension+  = NormalDeck {+      deckBrowserCollapsed  :: Value   -- TODO Bool?+    , deckConf              :: Value   -- TODO DeckOptionsId?+    , deckExtendNew         :: Value   -- TODO Int?+    , deckExtendRev         :: Value   -- TODO Int?+    }+  | DynamicDeck {+      deckDelays            :: Value   -- TODO Int?+    , deckResched           :: Value   -- TODO Bool?+    , deckReturn            :: Value   -- TODO Bool?+    , deckSeparate          :: Value   -- TODO Bool?+    , deckTerms             :: Value   -- TODO [[wtf]]?+    } deriving (Show, Eq, Generic)++instance FromJSON DeckExtension where+  parseJSON = withObject "DeckExtension" $ \o -> getBool <$> (o .: "dyn") >>= \case+      False -> do+        deckBrowserCollapsed <- o .: "browserCollapsed"+        deckConf             <- o .: "conf"+        deckExtendNew        <- o .: "extendNew"+        deckExtendRev        <- o .: "extendRev"+        return NormalDeck {..}++      True -> do+        deckDelays   <- o .: "delays"+        deckResched  <- o .: "resched"+        deckReturn   <- o .: "return"+        deckSeparate <- o .: "separate"+        deckTerms    <- o .: "terms"+        return DynamicDeck {..}+++-- | Options from cols.deck.dconf.lapse.+data DeckOptionsLapse = DeckOptionsLapse {+    dolLeechFails  :: Value -- TODO Int?+  , dolMinInt      :: Value -- TODO Int?+  , dolDelays      :: Value -- TODO [Int]?+  , dolLeechAction :: Value -- TODO Int/Enum?+  , dolMult        :: Value -- TODO Double?+  } deriving (Show, Eq, Generic)++instance FromJSON DeckOptionsLapse where+  parseJSON = genericParseJSON dropPrefixOptions+++-- | Options from cols.deck.dconf.new.+data DeckOptionsNew = DeckOptionsNew {+    donPerDay        :: Value -- TODO Int?+  , donDelays        :: Value -- TODO (Int, Int)?+  , donSeparate      :: Value -- TODO Bool?+  , donInts          :: Value -- TODO (Int, Int, Int)?+  , donInitialFactor :: Value -- TODO Double?+  , donBury          :: Value -- TODO Bool?+  , donOrder         :: Value -- TODO Int?+  } deriving (Show, Eq, Generic)++instance FromJSON DeckOptionsNew where+  parseJSON = genericParseJSON dropPrefixOptions+++-- | Options from cols.deck.dconf.rev+data DeckOptionsRev = DeckOptionsRev {+    dorPerDay   :: Value -- TODO Int?+  , dorFuzz     :: Value -- TODO Double?+  , dorIvlFct   :: Value -- TODO Double?+  , dorMaxIvl   :: Value -- TODO Double?+  , dorEase4    :: Value -- TODO Double?+  , dorBury     :: Value -- TODO Bool?+  , dorMinSpace :: Value -- TODO Int?+  } deriving (Show, Eq, Generic)++instance FromJSON DeckOptionsRev where+  parseJSON = genericParseJSON dropPrefixOptions+++-- | Type for deck ids.+type DeckId = WeaklyTypedInt++-- | Representation of a deck.+data Deck = Deck {+    deckId                :: DeckId+  , deckName              :: Value         -- TODO String?+  , deckCollapsed         :: Value         -- TODO Bool?+  , deckDesc              :: Value         -- TODO String?+  , deckMod               :: ModificationTime+  , deckUsn               :: Value         -- TODO Int?+  , deckLrnToday          :: Value         -- TODO (Int, Int)?+  , deckNewToday          :: Value         -- TODO (Int, Int)?+  , deckRevToday          :: Value         -- TODO (Int, Int)?+  , deckTimeToday         :: Value         -- TODO (Int, Int)?+  , deckExtension         :: DeckExtension+  } deriving (Show, Eq, Generic)+++instance FromJSON Deck where+  parseJSON = withObject "Deck" $ \o -> do+    deckName      <- o .: "name"+    deckCollapsed <- o .: "collapsed"+    deckDesc      <- o .: "desc"+    deckId        <- o .: "id"+    deckMod       <- o .: "mod"+    deckUsn       <- o .: "usn"+    deckLrnToday  <- o .: "lrnToday"+    deckNewToday  <- o .: "newToday"+    deckRevToday  <- o .: "revToday"+    deckTimeToday <- o .: "timeToday"+    deckExtension <- parseJSON $ Object o+    return Deck {..}++instance FromField [Deck] where+  fromField f = getJsonValue f >>= fromDictionary (mkEntry deckId DeckIdInconsistent) f
+ src/Anki/Misc.hs view
@@ -0,0 +1,34 @@+{-|+  Module:      Anki.Misc+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Misc types.+-}++module Anki.Misc (+    AnkiPathsConfiguration(..)+  ) where++import Data.Default (Default, def)++-- | Paths to all required files.+data AnkiPathsConfiguration = AnkiPathsConfiguration {+    apcRoot       :: FilePath -- ^ Root directory of Anki+  , apcPrefs      :: FilePath -- ^ Name of a preference file+  , apcCollection :: FilePath -- ^ Name of a collection file+  , apcMediaDB    :: FilePath -- ^ Name of a media database file+  , apcMediaDir   :: FilePath -- ^ Name of a directory with media+  } deriving (Show, Eq)++instance Default AnkiPathsConfiguration where+  def = AnkiPathsConfiguration {+     apcRoot       = "Documents/Anki"+   , apcPrefs      = "prefs.db"+   , apcCollection = "collection.anki2"+   , apcMediaDB    = "collection.media.db2"+   , apcMediaDir   = "collection.media"+   }
+ src/Anki/Model.hs view
@@ -0,0 +1,83 @@+{-|+  Module:      Anki.Model+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Representation of a model and related definitions.+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}++module Anki.Model (+    ModelId+  , Model(..)+  , ModelField(..)+  , ModelTemplate(..)+  ) where++import Anki.Common (WeaklyTypedInt, ModificationTime, AnkiException(..)) +import Anki.Common (dropPrefixOptions, getJsonValue, fromDictionary, mkEntry)+import Data.Aeson (Value(..), FromJSON(..), genericParseJSON)+import Database.SQLite.Simple.FromField (FromField(..))+import GHC.Generics (Generic)++-- | Type for model ids.+type ModelId = WeaklyTypedInt++-- | Model from col.models+data Model = Model {+    modelId        :: ModelId+  , modelCss       :: Value -- String?+  , modelDid       :: Value -- DeckId?+  , modelFlds      :: [ModelField]+  , modelLatexPre  :: Value -- TODO String?+  , modelLatexPost :: Value -- TODO String?+  , modelMod       :: ModificationTime+  , modelName      :: Value -- TODO String?+  , modelSortf     :: Value -- TODO Int?+  , modelTags      :: Value -- TODO: [wtf]?+  , modelTmpls     :: [ModelTemplate]+  , modelType      :: Value -- TODO Int?+  , modelUsn       :: Value -- TODO Int?+  , modelVers      :: Value -- TODO [wtf]?+  } deriving (Show, Eq, Generic)++instance FromJSON Model where+  parseJSON = genericParseJSON dropPrefixOptions++instance FromField [Model] where+  fromField f = getJsonValue f >>= fromDictionary (mkEntry modelId ModelIdInconsistent) f where+++-- | Field from col.models.flds+data ModelField = ModelField {+    mfName   :: String+  , mfMedia  :: Value -- TODO [wtf]?+  , mfSticky :: Value -- TODO Bool?+  , mfRtl    :: Value -- TODO Bool?+  , mfOrd    :: Value -- TODO Int?+  , mfFont   :: Value -- TODO String?+  , mfSize   :: Value -- TODO Int?+  } deriving (Show, Eq, Generic)++instance FromJSON ModelField where+  parseJSON = genericParseJSON dropPrefixOptions+++-- | Template from col.models.tmpls+data ModelTemplate = ModelTemplate {+    mtName  :: String+  , mtQfmt  :: Value -- TODO String?+  , mtDid   :: Value -- TODO DeckId?+  , mtBafmt :: Value -- TODO String?+  , mtAfmt  :: Value -- TODO String?+  , mtBqfmt :: Value -- TODO String?+  , mtOrd   :: Value -- TODO Int?+  } deriving (Show, Eq, Generic)++instance FromJSON ModelTemplate where+  parseJSON = genericParseJSON dropPrefixOptions
+ src/Anki/Note.hs view
@@ -0,0 +1,73 @@+{-|+  Module:      Anki.Note+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Representation of a note and related definitions.+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}++module Anki.Note (+    NoteId+  , Note(..)+  , NoteField(..)+  ) where++import Anki.Common (ModificationTime)+import Anki.Model (ModelId)+import Data.Char (chr)+import Data.Text (Text)+import Database.SQLite.Simple (FromRow(..), field)+import Database.SQLite.Simple.FromField (FromField(..))+import GHC.Generics (Generic)+import qualified Data.Text as T++-- | Type for note ids.+type NoteId = Int++fieldSeparator :: Char+fieldSeparator = chr 0x1F++-- | Notes from notes table.+data Note = Note {+    noteId    :: NoteId+  , noteGuid  :: String+  , noteMid   :: ModelId+  , noteMod   :: ModificationTime+  , noteUsn   :: Int -- TODO check type+  , noteTags  :: String -- TODO ?+  , noteFlds  :: [NoteField]+  , noteSfld  :: NoteField+  , noteCsum  :: Int -- TODO check type+  , noteFlags :: Int -- TODO check type+  , noteData  :: String -- TODO check type+  } deriving (Show, Eq, Generic)++instance FromRow Note where+  fromRow = Note+    <$> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field+    <*> field++-- | Representation of note fields as they store in the database.+newtype NoteField = NoteField { getNoteField :: Text } deriving (Show, Eq)++instance FromField NoteField where+  fromField f = NoteField <$> fromField f++instance FromField [NoteField] where+  fromField f = (fmap NoteField . T.split (== fieldSeparator)) <$> fromField f+
+ src/Anki/Tools.hs view
@@ -0,0 +1,59 @@+{-|+  Module:      Anki.Tools+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Tools to work with collection.+-}++ {-# LANGUAGE OverloadedStrings #-}+ {-# LANGUAGE RecordWildCards   #-}++module Anki.Tools (+    getUserProfiles+  , getCollections+  , getNotes+  , getCards+  ) where++import Anki.Misc+import Anki.UserProfile+import Anki.Collection+import Anki.Note+import Anki.Card+import Control.Exception (bracket)+import Database.SQLite.Simple (open, close, query_)+import System.Directory (getHomeDirectory)+import System.FilePath (joinPath)+++-- | Extract user profiles from the given anki configuration.+getUserProfiles :: AnkiPathsConfiguration -> IO [UserProfile]+getUserProfiles (AnkiPathsConfiguration {..}) = bracket+  (open =<< (joinPath . (:[apcRoot, apcPrefs]) <$> getHomeDirectory))+  (close)+  (flip query_ "select name from profiles")++-- | Extract available collections from the given profile.+getCollections :: AnkiPathsConfiguration -> UserProfile -> IO [Collection]+getCollections (AnkiPathsConfiguration {..}) (UserProfile {..}) = bracket+  (open =<< (joinPath . (:[apcRoot, upName, apcCollection]) <$> getHomeDirectory))+  (close)+  (flip query_ "select id, crt, mod, scm, ver, dty, usn, ls, conf, models, decks, dconf, tags from col")++-- | Extract all notes from from the given profile.+getNotes :: AnkiPathsConfiguration -> UserProfile -> IO [Note]+getNotes (AnkiPathsConfiguration {..}) (UserProfile {..}) = bracket+  (open =<< (joinPath . (:[apcRoot, upName, apcCollection]) <$> getHomeDirectory))+  (close)+  (flip query_ "select id, guid, mid, mod, usn, tags, flds, sfld, csum, flags, data from notes")++-- | Extract all cards from from the given profile.+getCards :: AnkiPathsConfiguration -> UserProfile -> IO [Card]+getCards (AnkiPathsConfiguration {..}) (UserProfile {..}) = bracket+  (open =<< (joinPath . (:[apcRoot, upName, apcCollection]) <$> getHomeDirectory))+  (close)+  (flip query_ "select id, nid, did, ord, mod, usn, type, queue, due, ivl, factor, reps, lapses, left, odue, odid, flags, data from cards limit 20")
+ src/Anki/UserProfile.hs view
@@ -0,0 +1,27 @@+{-|+  Module:      Anki.UserProfile+  Copyright:   (c) 2016 Al Zohali+  License:     BSD3+  Maintainer:  Al Zohali <zohl@fmap.me>+  Stability:   experimental++  = Description+  Representation of a user profile and related definitions.+-}++module Anki.UserProfile (+    UserProfile(..)+  ) where++import Database.SQLite.Simple (FromRow(..), field)++-- | User profile as in profile table in prefs.db+data UserProfile = UserProfile {+    upName :: String -- ^ Profile name (profile.name)++  -- TODO: upData :: String -- ^ profile.data+  } deriving (Show, Eq)++instance FromRow UserProfile where+  fromRow = UserProfile <$> field+
+ test/Main.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE LambdaCase #-}++import Data.Default (def)+import System.Environment (getArgs)+import Anki.Tools+import Anki.Collection+import Anki.Note+import Anki.Card+import Anki.UserProfile+++splitArgs :: [String] -> [(String, String)]+splitArgs []       = []+splitArgs (_:[])   = error "splitArgs failed to process args"+splitArgs (x:y:xs) = (x, y):(splitArgs xs)++firstMatch :: (Eq a) => (b -> a) -> Maybe a -> ([b] -> b)+firstMatch f = maybe head (\x -> head . filter ((== x) . f))++getUserProfile :: Maybe String -> IO UserProfile+getUserProfile m = firstMatch upName m <$> getUserProfiles def++getCollection :: UserProfile -> Maybe Int -> IO Collection+getCollection p m = firstMatch collectionId m <$> getCollections def p++main :: IO ()+main = do+  args <- splitArgs <$> getArgs++  userProfile <- getUserProfile $ lookup "--user-profile" args+  -- let output = show userProfile++  -- collection <- getCollection userProfile $ read <$> (lookup "--collection" args)+  -- let output = show collection++  -- notes <- getNotes def userProfile+  -- let output = show notes++  cards <- getCards def userProfile+  let output = show cards++  putStrLn output